QRZ! Ham Radio 8/QRZ Ham Radio Callsign Database - Volume 8.iso/mac/german/tcpip/gp160.exe/#GPRI.EXE/CONV.PAS

Pascal/Delphi Source File | 1993-09-13 | 8KB | 358 lines

{$M 1024,0,0}
{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V+,X-}

PROGRAM Conv;   { Convers für GP }


USES Dos,GPRI;

CONST
  GPConvers            = 0;
  Version              = '1.00';
  OK                   = '#OK#';
  CR                   = #13;
  SendConversMessage   = 0;
  GetAllConversUsers   = 1;
  GetChannelUsers      = 2;
  SendPrivateMessage   = 3;
  HelpStr1             = #13'*** convers help:'#13+
                            ' /CHannel <n>   or'#13+
                            ' /<n>           switch to channel <n>'#13+
                            ' /Disconnect    disconnects the qso'#13+
                            ' /Help          This text'#13+
                            ' /MSG <call>    Sends a private msg to <call>'#13;

  HelpStr2             =    ' /Quit          Terminates the convers session'#13+
                            ' /Who           List of all logged in stations'#13+
                            '***'#13#13;


TYPE
  Str10         = String[10];
  ConversData   = RECORD
                    FNr,
                    Chan   : Word;
                    Data   : String;
                    ToCall : Str10;
                  END;



VAR
  ConversKanal    : Word;
  QSOData         : QSODataType;
  RightVersion    : Boolean;



PROCEDURE Parse (VAR S : String; Sysop : Boolean); Forward;




PROCEDURE UpdateUserList (VAR D : ConversData);

VAR
  S   : Str10;

BEGIN
  Str(ConversKanal:6,S);
  WITH D DO
    IF (FNr = GetAllConversUsers) OR (Chan = ConversKanal) THEN
      Data := Concat(Data,S,':',QSOData.Call,CR);
END;



PROCEDURE SysopMessage (VAR S : String); far;

VAR
  D   : ConversData;

BEGIN
  IF S[1] = '/' THEN
    Parse(S,TRUE)
  ELSE BEGIN
    WITH D DO BEGIN
      Data := Concat('-',QSOData.MyCall,'-:',S);
      Chan := ConversKanal;
      FNr := SendConversMessage;
    END;
    SendGPRIMessage(GPConvers,D);
    SendString(D.Data);
  END;
  S := '';
END;


PROCEDURE GetPrivateMsg (VAR D : ConversData);

BEGIN
  WITH D DO
    IF ToCall = QSOData.Call THEN BEGIN
      SendString(Data);
      ToCall := OK;
    END;
END;



PROCEDURE GetConversMessage (Ident : Word; VAR D : ConversData); far;

BEGIN
  IF Ident = GPConvers THEN WITH D DO BEGIN
    CASE FNr OF
      SendConversMessage : IF Chan = ConversKanal THEN SendString(Data);
      GetAllConversUsers : UpdateUserList(D);
      GetChannelUsers    : UpdateUserList(D);
      SendPrivateMessage : GetPrivateMsg(D);
    END;
  END;
END;



PROCEDURE UserListe (Mode : Word);

VAR
  D   : ConversData;
  S   : Str10;

BEGIN
  Str(ConversKanal:6,S);
  WITH D DO BEGIN
    Data := Concat('*** convers users:'#13,S,':',QSOData.MyCall,' (SysOp)',CR);
    Chan := ConversKanal;
    FNr := Mode;
  END;
  UpdateUserList(D);
  SendGPRIMessage(GPConvers,D);
  SendString(D.Data);
  SendString('***'#13#13);
END;



PROCEDURE Login (Chan : Word);

VAR
  D  : ConversData;
  S  : Str10;

BEGIN
  Str(Chan,S);
  IF Chan <> ConversKanal THEN BEGIN
    WITH D DO BEGIN
      FNr := SendConversMessage;
      Data := Concat('-',QSOData.Call,'- *** switched to channel ',S,CR);
      Chan := ConversKanal;
    END;
    SendGPRIMessage(GPConvers,D);
    SendString('*** now on channel '+S+CR);
  END;
  ConversKanal := Chan;
  WITH D DO BEGIN
    FNr := SendConversMessage;
    Data := Concat('-',QSOData.Call,'- *** login',CR);
    Chan := ConversKanal;
  END;
  SendGPRIMessage(GPConvers,D);
  UserListe(GetChannelUsers);
END;



PROCEDURE GrossSchrift (VAR S);

VAR
  L : Byte;

BEGIN
  FOR L := 1 TO Byte(S) DO String(S)[L] := UpCase(String(S)[L]);
END;



FUNCTION BefehlErkannt (Befehl,S : String; Min : Byte) : Boolean;

VAR
  I,N      : Byte;
  Gefunden : Boolean;

BEGIN
  GrossSchrift(S);
  Gefunden := FALSE;
  I := Min;
  WHILE (I <= Byte(Befehl[0])) AND NOT Gefunden DO BEGIN
    Gefunden := (Pos(Copy(Befehl,1,I)+' ',S) = 1) OR (Pos(Copy(Befehl,1,I)+CR,S) = 1);
    Inc(I);
  END;
  BefehlErkannt := Gefunden;
END;




PROCEDURE Parse (VAR S : String; Sysop : Boolean);

VAR
  Dummy,
  Fehler   : Integer;
  D        : ConversData;

BEGIN
  IF (Byte(S[0]) > 0) AND (S[1] = '/') THEN BEGIN
    Delete(S,1,1);
    IF BefehlErkannt('HELP',S,1) THEN BEGIN
      SendString(HelpStr1);
      SendString(HelpStr2);
      Exit;
    END;
    IF BefehlErkannt('WHO',S,1) THEN BEGIN
      UserListe(GetAllConversUsers);
      Exit;
    END;
    IF BefehlErkannt('QUIT',S,1) THEN BEGIN
      SendString(#13'*** convers session terminated. 73...'#13);
      ProgrammEnde := TRUE;
      Exit;
    END;
    IF BefehlErkannt('DISCONNECT',S,1) THEN BEGIN
      SendString(#13'*** convers session terminated. 73...'#13);
      DisconnectChannel;
      Exit;
    END;
    IF BefehlErkannt('CHANNEL',S,2) THEN BEGIN
      Dummy := Pos(' ',S);
      IF Dummy > 0 THEN
        Delete(S,1,Dummy)
      ELSE BEGIN
        SendString('*** argument required.'#13);
        Exit;
      END;
    END;
    IF BefehlErkannt('MSG',S,1) THEN BEGIN
      Dummy := Pos(' ',S);
      IF Dummy > 0 THEN BEGIN
        Delete(S,1,Dummy);
        WHILE (S[0] > #0) AND (S[1] = ' ') DO Delete(S,1,1);
        Dummy := Pos(' ',S);
        IF Dummy > 0 THEN BEGIN
          D.ToCall := Copy(S,1,Dummy-1);
          GrossSchrift(D.ToCall);
          WHILE (S[0] > #0) AND (S[1] = ' ') DO Delete(S,1,1);
          IF Sysop THEN
            D.Data := Concat('*',QSOData.MyCall,'*:',Copy(S,Dummy+1,Byte(S[0])))
          ELSE
            D.Data := Concat('*',QSOData.Call,'*:',Copy(S,Dummy+1,Byte(S[0])));
          D.FNr := SendPrivateMessage;
          D.Chan := 0;
          SendGPRIMessage(GPConvers,D);
          IF D.ToCall <> OK THEN
            SendString('*** station not connected.'#13);
        END ELSE
          SendString('*** where''s the text???'#13);
      END ELSE
        SendString('*** argument required.'#13);
      Exit;
    END;

    Val(Copy(S,1,Byte(S[0])-1),Dummy,Fehler);
    IF (Fehler = 0) THEN BEGIN
      IF Dummy <> ConversKanal THEN
        Login(Dummy)
      ELSE
        SendString('*** already on channel '+S);
      Exit;
    END;
    SendString(#13'*** unknown convers command.'#13#13);
  END;
END;





PROCEDURE RX (VAR S : String); far;

VAR
  D   : ConversData;

BEGIN
  IF S[1] = '/' THEN
    Parse(S,FALSE)
  ELSE BEGIN
    WITH D DO BEGIN
      FNr := SendConversMessage;
      Data := Concat('-',QSOData.Call,'-:',S);
      Chan := ConversKanal;
    END;
    SendGPRIMessage(GPConvers,D);
  END;
END;



PROCEDURE Init; far;

VAR
  S   : String;
  D   : ConversData;
  P   : Byte;
  F   : Integer;

BEGIN
  IF NOT RightVersion THEN BEGIN
    S := CR+'*** GPRI Version 1.1 required.'+CR+CR;
    ProgrammEnde := TRUE;
    SendString(S);
    Exit;
  END ELSE
    S := #13'*** GP-Convers Revision '+Version+'  (C) Ulf Saran, DH1DAE 1993'#13+
            '*** Type /H for help'#13#13;
  SendString(S);
  IF ParamCount > 0 THEN BEGIN
    Val(ParamStr(1),ConversKanal,F);
    IF F > 0 THEN BEGIN
      SendString('*** invalid channel number.'#13);
      ConversKanal := 0;
    END;
  END ELSE
    ConversKanal := 0;
  GetQSOData(QSOData);
  WITH QSOData DO BEGIN
    P := Pos('-',Call);
    IF P > 0 THEN Delete(Call,P,3);  { SSID weglassen }
    P := Pos('-',MyCall);
    IF P > 0 THEN Delete(MyCall,P,3);  { SSID weglassen }
  END;
  Login(ConversKanal);
END;



PROCEDURE Ende; far;

VAR
  D  : ConversData;

BEGIN
  WITH D DO BEGIN
    Data := Concat('-',QSOData.Call,'- *** logout'#13);
    FNr := SendConversMessage;
    Chan := ConversKanal;
  END;
  SendGPRIMessage(GPConvers,D);
END;



BEGIN
  RightVersion := InstallTXHandler(@SysopMessage) AND
                  InstallGPRIMessageHandler(@GetConversMessage);
  IF NOT TaskInit(@Init,@RX,NIL,@Ende) THEN BEGIN
    Writeln('Kein GPRI-Host gefunden, Programm kann nicht gestartet werden.');
    Halt;
  END;
  Keep(0);
END.